home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byteibm.arc / DAHMKE.ARC / MCDFIG8.FOR < prev   
Text File  |  1985-07-12  |  2KB  |  115 lines
  1. $STORAGE: 2
  2. C
  3. C
  4. C    Demonstration MS-FORTRAN program using assembler
  5. C    subroutine calls.
  6. C
  7. C    by Mark Dahmke
  8. C    May, 1986
  9. C
  10. C    This program displays the current directory path,
  11. C    then allows you to enter a new directory name.
  12. C    Next, it displays all filenames in the directory, 
  13. C    and also shows the amount of free disk space remaining.
  14. C
  15. C
  16.     CHARACTER*65 PATH
  17.     CHARACTER*11 FSPEC 
  18.     CHARACTER*11 FNAME
  19.     CHARACTER*1  ZERO
  20.     INTEGER IDRIVE,ICODE
  21.     INTEGER*4 ISPACE
  22. C
  23. C
  24.     DATA PATH  /' '/
  25.     DATA FSPEC /'???????????'/
  26.     DATA FNAME /' '/
  27. C
  28.     ZERO = CHAR(0)
  29. C
  30. C  GET PATH NAME:
  31. C
  32. C
  33.     IDRIVE = 0
  34. C
  35.     CALL GETDIR(PATH,IDRIVE,ICODE)
  36. C
  37.     IF (ICODE .NE. 0) THEN
  38.        WRITE(*,*) ' ERROR RETURN: ',ICODE
  39.        ENDIF
  40. C
  41. C --- CLEAR OUT THE ZERO BYTE BEFORE WRITING TO CONSOLE...
  42. C
  43.     DO 4 I = 1, 65
  44.        IF (PATH(I:I) .EQ. ZERO) PATH(I:I) = ' ' 
  45. 4        CONTINUE
  46. C
  47.     WRITE(*,*) ' Current Directory is: ',PATH
  48. C
  49. C    
  50. C  ---- CHANGE DIRECTORY
  51. C
  52.     PATH = ' '
  53. 5     WRITE(*,*) ' Enter name of directory: '
  54.     READ(*,6) PATH
  55. 6    FORMAT(A65)
  56. C
  57. C  ---- SCAN PATH NAME TO FIND LAST CHARACTER.
  58. C    INSERT A ZERO BYTE AT THE END OF THE STRING.
  59. C    
  60.     I = 64        
  61. 10    IF (PATH(I:I) .NE. ' ') GO TO 20
  62.     I = I - 1
  63.     IF (I .EQ. 0) GO TO 5 
  64.     GO TO 10
  65. 20    I = I + 1
  66.       PATH(I:I) = ZERO   
  67. C
  68. C
  69. C
  70.      CALL CHDIR(PATH,ICODE)
  71. C
  72.     IF (ICODE .NE. 0) THEN
  73.        WRITE(*,*) ' INVALID DIRECTORY NAME OR FORMAT '
  74.        ENDIF
  75. C
  76. C ---- DISPLAY FILE NAMES IN THE CURRENT DIRECTORY.
  77. C
  78. C
  79.     CALL SRCHF(IDRIVE,FSPEC,FNAME)
  80. C
  81.     IF (FNAME(1:1) .EQ. '?') THEN
  82.        WRITE(*,*) ' NO FILES'
  83.        GO TO 100
  84.        ENDIF
  85. C
  86.     WRITE(*,40) FNAME(1:8),FNAME(9:11)
  87. 40    FORMAT(1X,A8,'.',A3)
  88. C
  89. C ---- CONTINUE TO READ FILE NAMES
  90. C
  91. C
  92. 50    CALL SRCHN(IDRIVE,FSPEC,FNAME)
  93. C  
  94.     IF (FNAME(1:1) .EQ. '?') GO TO 100
  95. C
  96.     WRITE(*,40) FNAME(1:8),FNAME(9:11)
  97.     GO TO 50
  98. C
  99. C
  100. C ---- GET DISK FREE SPACE
  101. C
  102. C
  103. 100    CALL GETDFS(IDRIVE,IBYTES,ISECT,ICLUST)
  104. C
  105.     ISPACE = IBYTES * ISECT * ICLUST
  106. C
  107.     WRITE(*,60) IDRIVE,IBYTES,ISECT,ICLUST,ISPACE
  108. 60    FORMAT(' Drive ',I2,' has ',I6,' bytes per sector',/,
  109.      &  1X,I6,' sectors per cluster, and ',I8, ' free clusters.',//,
  110.      &  ' Total free space in bytes = ',I12)
  111. C
  112. C
  113.     STOP
  114.     END
  115.